home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / ppl4p10.zip / XYPACKET.PAS < prev    next >
Pascal/Delphi Source File  |  1995-02-20  |  12KB  |  434 lines
  1. (**********************************************)
  2. (*        Copyright (C) 1995 by               *)
  3. (*     MarshallSoft Computing, Inc.           *)
  4. (**********************************************)
  5.  
  6. { $DEFINE DEBUG}
  7. {$I DEFINES.PAS}
  8.  
  9. unit xypacket;
  10.  
  11. interface
  12.  
  13. uses config,crt,term_io,crc16,hex_io,file_io,PCL4P;
  14.  
  15. Function TxPacket(Port:Integer;
  16.                   PacketNbr:Word;
  17.                   PacketSize:Word;
  18.               Var Buffer:BufferType;
  19.                   NCGbyte:Byte):Boolean;
  20.  
  21. Function RxPacket(Port:Integer;
  22.                   PacketNbr:Word;
  23.               Var PacketSize:Word;
  24.               Var Buffer:BufferType;
  25.                   NCGbyte:Byte;
  26.               Var EOTflag:Boolean):Boolean;
  27.  
  28. Function RxStartup(Port:Integer;
  29.               Var NCGbyte:Byte):Boolean;
  30.  
  31. Function TxStartup(Port:Integer;
  32.               Var NCGbyte:Byte):Boolean;
  33.  
  34. Function TxEOT(Port:Integer):Boolean;
  35.  
  36. implementation
  37.  
  38.  
  39. const MAXTRY = 3;
  40.       LIMIT = 20;
  41.  
  42. const SOH = $01;
  43.       STX = $02;
  44.       EOT = $04;
  45.       ACK = $06;
  46.       NAK = $15;
  47.       CAN = $18;
  48.  
  49.  
  50. procedure TimeoutMsg(Message:String;Packet:Word);
  51. begin
  52.   WriteIntMsg('Timed out for '+Message+'. Packet ',Packet)
  53. end;
  54.  
  55. Function TxPacket(Port:Integer;         (* Port # [0..3] *)
  56.                   PacketNbr:Word;       (* Packet # [0,1,2,...] *)
  57.                   PacketSize:Word;      (* Packet size [128,1024] *)
  58.               Var Buffer:BufferType;    (* 1K character buffer *)
  59.                   NCGbyte:Byte)         (* NAK, 'C', or 'G' *)
  60.                 : Boolean;              (* successfull *)
  61. Var
  62.   I         : Integer;
  63.   Code      : Integer;
  64.   CheckSum  : Word;
  65.   Attempt   : Word;
  66.   PacketType: Byte;
  67. Begin
  68.   (* better be 128 or 1024 packet length *)
  69.   case PacketSize of
  70.     128: PacketType := SOH;
  71.     1024: PacketType := STX;
  72.     else
  73.       begin
  74.         WriteLn('Bad packet size!');
  75.         TxPacket := FALSE;
  76.         exit
  77.       end;
  78.   end; (* case *)
  79.   PacketNbr := PacketNbr and $00ff;
  80.   (* make up to MAXTRY attempts to send this packet *)
  81.   for Attempt := 1 to MAXTRY do
  82.     begin
  83.       (* send SOH/STX  *)
  84.       PutChar(Port,PacketType);
  85.       (* send packet # *)
  86.       PutChar(Port,PacketNbr);
  87.       (* send 1's complement of packet *)
  88.       PutChar(Port,255-PacketNbr);
  89.       (* send data *)
  90.       CheckSum := 0;
  91.       for i := 0 to PacketSize - 1 do
  92.         begin
  93.           PutChar(Port,Buffer[i]);
  94.           (* update checksum *)
  95.           if NCGbyte<>NAK then CheckSum := UpdateCRC(Buffer[i],CheckSum)
  96.           else CheckSum := CheckSum + Buffer[i];
  97.           (* don't overun TX buffer *)
  98.           if (i mod 32) = 0 then
  99.             while (SioTxQue(Port) >= SioBufSize-32) do SioDelay(1);
  100.         end;
  101. {$IFDEF DEBUG}
  102. write('<Checksum=$');
  103. WriteHexWord(CheckSum);
  104. write('>');
  105. {$ENDIF}
  106.       (* send checksum *)
  107.       if NCGbyte<>NAK then
  108.         begin
  109.           (* send 2 byte CRC *)
  110.           PutChar(Port, (CheckSum shr 8) AND $00ff );
  111.           PutChar(Port, CheckSum AND $00ff );
  112.         end
  113.       else (* NCGbyte = 'C' or 'G' *)
  114.         begin
  115.           (* send one byte checksum *)
  116.           PutChar(Port, $00ff AND CheckSum );
  117.         end;
  118.       (* don't wait for ACK if 'G' *)
  119.       if NCGbyte = Ord('G') then
  120.         begin
  121.            if PacketNbr = 0 then delay(SHORT_WAIT*ONE_SECOND div 2);
  122.            TxPacket := TRUE;
  123.            exit
  124.         end;
  125.       (* read next disk buffer while waiting for ACK *)
  126.       fioPreRead;
  127.       (* wait for receivers ACK *)
  128.       Code := GetChar(Port,LONG_WAIT*ONE_SECOND);
  129.       if Code = CAN then
  130.          begin
  131.             WriteLn('Canceled by remote');
  132.             TxPacket := FALSE;
  133.             exit
  134.           end;
  135.       if Code = ACK then
  136.           begin
  137.             TxPacket := TRUE;
  138.             exit
  139.           end;
  140.       if Code <> NAK then
  141.           begin
  142.             WriteLn('Out of sync');
  143.             TxPacket := FALSE;
  144.             exit
  145.           end;
  146.        WriteLn(PacketNbr,' NAKed');
  147.     end; (* end for *)
  148.   (* can't send packet ! *)
  149.   TimeoutMsg('Retry exceeded',PacketNbr);
  150.   TxPacket := FALSE
  151. end; (* end -- TxPacket *)
  152.  
  153. Function RxPacket(Port:Integer;           (* Port # 0..3 *)
  154.                   PacketNbr:Word;         (* Packet # [0,1,2,...] *)
  155.               Var PacketSize:Word;        (* Packet size (128 or 1024) *)
  156.               Var Buffer:BufferType;      (* 1K buffer *)
  157.                   NCGbyte:Byte;           (* NAK, 'C', or 'G' *)
  158.               Var EOTflag:Boolean)        (* EOT was received *)
  159.                   :Boolean;               (* success / failure *)
  160. Var
  161.   I            : Integer;
  162.   Code         : Integer;
  163.   Attempt      : Word;
  164.   RxPacketNbr  : Word;
  165.   RxPacketNbrC : Word;
  166.   CheckSum     : Word;
  167.   RxCheckSum   : Word;
  168.   RxCheckSum1  : Word;
  169.   RxCheckSum2  : Word;
  170.   PacketType   : Byte;
  171. begin
  172.   PacketNbr := PacketNbr AND $00ff;
  173.   for Attempt := 1 to MAXTRY do
  174.     begin
  175.       (* wait for SOH / STX *)
  176.       Code := GetChar(Port,LONG_WAIT*ONE_SECOND);
  177.       if Code = -1 then
  178.         begin
  179.           WriteLn('Timed out waiting for sender');
  180.           RxPacket := FALSE;
  181.           exit
  182.         end;
  183.       case Code of
  184.         SOH: begin
  185.                (* 128 byte buffer incoming *)
  186.                PacketType := SOH;
  187.                PacketSize := 128
  188.              end;
  189.         STX: begin
  190.                (* 1024 byte buffer incoming *)
  191.                PacketType := STX;
  192.                PacketSize := 1024;
  193.              end;
  194.         EOT: begin
  195.                (* all packets have been sent *)
  196.                PutChar(Port,ACK);
  197.                EOTflag := TRUE;
  198.                RxPacket := TRUE;
  199.                exit
  200.              end;
  201.         CAN: begin
  202.                (* sender has canceled ! *)
  203.                SayError(Port,'Canceled by remote');
  204.                RxPacket := FALSE;
  205.              end;
  206.         else
  207.             begin
  208.               (* error ! *)
  209.               Write('Expecting SOH/STX/EOT/CAN not $');
  210.               WriteHexByte(Code);
  211.               WriteLn;
  212.               RxPacket := FALSE;
  213.             end;
  214.       end; (* case *)
  215.       (* receive packet # *)
  216.       Code := GetChar(Port,ONE_SECOND);
  217.       if Code = -1 then
  218.         begin
  219.           TimeoutMsg('packet #',PacketNbr);
  220.           exit
  221.         end;
  222.       RxPacketNbr := $00ff and Code;
  223.       (* receive 1's complement *)
  224.       Code := GetChar(Port,ONE_SECOND);
  225.       if Code =-1 then
  226.         begin
  227.           TimeoutMsg('packet # complement',PacketNbr);
  228.           RxPacket := FALSE;
  229.           exit
  230.         end;
  231.       RxPacketNbrC := $00ff and Code;
  232.       (* receive data *)
  233.       CheckSum := 0;
  234.       for i := 0 to PacketSize - 1 do
  235.         begin
  236.           Code := GetChar(Port,ONE_SECOND);
  237.           if Code = -1 then
  238.             begin
  239.               TimeoutMsg('data',PacketNbr);
  240.               RxPacket := FALSE;
  241.               exit
  242.             end;
  243.           Buffer[i] := Code;
  244.           (* compute CRC or checksum *)
  245.           if NCGbyte <> NAK
  246.             then CheckSum := UpdateCRC(Code,CheckSum)
  247.             else CheckSum := (CheckSum + Code) AND $00ff;
  248.         end;
  249.       (* receive CRC/checksum *)
  250.       if NCGbyte<>NAK then
  251.         begin
  252.           (* receive 2 byte CRC *)
  253.           Code := GetChar(Port,ONE_SECOND);
  254.           if Code =-1 then
  255.             begin
  256.               TimeoutMsg('1st CRC byte',PacketNbr);
  257.               RxPacket := FALSE;
  258.               exit
  259.             end;
  260.           RxCheckSum1 := Code AND $00ff;
  261.           Code := GetChar(Port,ONE_SECOND);
  262.           if Code =-1 then
  263.             begin
  264.               TimeoutMsg('2nd CRC byte',PacketNbr);
  265.               RxPacket := FALSE;
  266.               exit
  267.             end;
  268.           RxCheckSum2 := Code AND $00ff;
  269.           RxCheckSum := (RxCheckSum1 SHL 8) OR RxCheckSum2;
  270.         end
  271.       else
  272.         begin
  273.           (* receive one byte checksum *)
  274.           Code := GetChar(Port,ONE_SECOND);
  275.           if Code = -1 then
  276.             begin
  277.               TimeoutMsg('checksum',PacketNbr);
  278.               RxPacket := FALSE;
  279.               exit
  280.              end;
  281.           RxCheckSum := Code AND $00ff;
  282.         end;
  283.      (* don't send ACK if 'G' *)
  284.      if NCGbyte = Ord('G') then
  285.         begin
  286.            RxPacket := TRUE;
  287.            exit
  288.         end;
  289.      (* packet # and checksum OK ? *)
  290.      if (RxCheckSum=CheckSum) and (RxPacketNbr=PacketNbr) then
  291.        begin
  292.          (* ACK the packet *)
  293.          PutChar(Port,ACK);
  294.          RxPacket := TRUE;
  295.          exit
  296.        end;
  297.      (* bad packet *)
  298.      {$IFDEF DEBUG}
  299.      write('<Checksum: Received=$');
  300.      WriteHexWord(RxCheckSum);
  301.      write(', Computed=$');
  302.      WriteHexWord(CheckSum);
  303.      write('> ');
  304.      {$ENDIF}
  305.      WriteIntMsg('NAKing packet ',PacketNbr);
  306.      PutChar(Port,NAK)
  307.    end;
  308.    (* can't receive packet *)
  309.    TimeoutMsg('NAK retry exceeded',PacketNbr);
  310.    RxPacket := FALSE
  311. end; (* end -- RxPacket *)
  312.  
  313. Function TxStartup(Port:Integer;
  314.                Var NCGbyte:Byte):Boolean;
  315. Label 999;
  316. Var
  317.   Code : Integer;
  318.   I : Integer;
  319.   Result : Boolean;
  320. Begin
  321.   (* clear Rx buffer *)
  322.   Code := SioRxFlush(Port);
  323.   (* wait for receivers start up NAK or 'C' *)
  324.   for i := 1 to LIMIT do
  325.     begin
  326.       if KeyPressed then
  327.         begin
  328.           SayError(Port,'Aborted by user');
  329.           Result := FALSE;
  330.           Goto 999
  331.         end;
  332.       Code := GetChar(Port,ONE_SECOND);
  333.       if Code <> -1  then
  334.         begin
  335.          (* received a byte *)
  336.          if Code = NAK then
  337.            begin
  338.              NCGbyte := NAK;
  339.              Result := TRUE;
  340.              Goto 999
  341.           end;
  342.         if Code = Ord('C') then
  343.           begin
  344.             NCGbyte := Ord('C');
  345.             Result := TRUE;
  346.             Goto 999
  347.           end;
  348.         if Code = Ord('G') then
  349.           begin
  350.             NCGbyte := Ord('G');
  351.             Result := TRUE;
  352.             Goto 999
  353.           end
  354.         end
  355.       end;
  356.   (* no response *)
  357.   WriteMsg('No response from receiver');
  358.   TxStartup := FALSE;
  359. 999:
  360.   TxStartup := Result;
  361. {$IFDEF DEBUG}
  362.   write('<TxStartup ');
  363.   if Result then writeln('successfull>')
  364.   else writeln('fails>');
  365. {$ENDIF}
  366. end; (* end -- TxStartup *)
  367.  
  368.  
  369. Function RxStartup(Port:Integer;
  370.                Var NCGbyte:Byte)
  371.                  : Boolean;
  372. Label 999;
  373. Var
  374.   I : Integer;
  375.   Code : Integer;
  376.   Result : Boolean;
  377. Begin
  378.   (* clear Rx buffer *)
  379.   Code := SioRxFlush(Port);
  380.   (* Send NAKs or 'C's *)
  381.   for I := 1 to LIMIT do
  382.     begin
  383.       if KeyPressed then
  384.         begin
  385.           SayError(Port,'Canceled by user');
  386.           Result := FALSE;
  387.           Goto 999
  388.         end;
  389.       (* stop attempting CRC after 1st 4 tries *)
  390.       if (NCGbyte<>NAK) and (i=5) then  NCGbyte := NAK;
  391.       (* tell sender that I am ready to receive *)
  392.       PutChar(Port,NCGbyte);
  393.       Code := GetChar(Port,ONE_SECOND);
  394.       if Code <> -1 then
  395.         begin
  396.           (* no error -- must be incoming byte -- push byte back onto queue ! *)
  397.           Code := SioUnGetc(Port,Code);
  398.           Result := TRUE;
  399.           Goto 999
  400.         end;
  401.     end; (* for i *)
  402.   (* no response *)
  403.   WriteMsg('No response from sender');
  404.   Result := FALSE;
  405. 999:
  406.   RxStartup := Result;
  407. {$IFDEF DEBUG}
  408.   write('<RxStartup ');
  409.   if Result then writeln('successfull>')
  410.   else writeln('fails>');
  411. {$ENDIF}
  412. end; (* end -- RxStartup *)
  413.  
  414. Function TxEOT(Port:Integer):Boolean;
  415. Var
  416.   I    : Integer;
  417.   Code : Integer;
  418. Begin
  419.   for I := 0 to 10 do
  420.     begin
  421.       PutChar(Port,EOT);
  422.       (* await response *)
  423.       Code := GetChar(Port,ONE_SECOND);
  424.       if Code = ACK then
  425.         begin
  426.           TxEOT := TRUE;
  427.           exit
  428.         end
  429.     end; (* end -- for I) *)
  430.   TxEOT := FALSE
  431. end; (* end -- TxEOT *)
  432.  
  433. end.
  434.